home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / opv.mod (.txt) < prev    next >
Oberon Text  |  1996-06-09  |  29KB  |  880 lines
  1. Syntax10.Scn.Fnt
  2. StampElems
  3. Alloc
  4. 9 Jun 96
  5. FoldElems
  6. Syntax10.Scn.Fnt
  7. PROCEDURE f1():REAL;
  8. BEGIN
  9.      RETURN 8
  10. END f1;
  11. PROCEDURE Do*;
  12. BEGIN
  13.     f:=f1;
  14.      w:=f(); Out.Real(w,8);
  15.      w:=f1(); Out.Real(w,8);
  16. END Do;
  17. MODULE OPV;
  18. (* Control Module for the backend of the Oberon-2-Compiler for Sun-3.
  19.     Diplomarbeit Samuel Urech
  20.     Date: 30.10.92   Current version: 
  21.     Try to fix a bug in Expr. Hope it will work. RD 17.4.96
  22.  had problems
  23.     Added SYSTEM.CALL     (*<<OJ*)    *)
  24.     IMPORT OPT, OPC, OPL, OPM;
  25.     CONST
  26.         (* object modes *)
  27.         Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
  28.         SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
  29.         (* opcodes *)
  30.         ASh = 0; LSh = 1; ROt = 3;
  31.         (* Condition codes *)
  32.         false = 1; true = 0;
  33.         CC = 4; CS = 5; EQ = 7; GE = 12; GT = 14; HI = 2; LE = 15;
  34.         LS = 3; LT = 13; MI = 11; NE = 6; PL = 10; VC = 8; VS = 9;
  35.         (* operation node subclasses *)
  36.         times = 1; slash = 2; div = 3; mod = 4;
  37.         and = 5; plus = 6; minus = 7; or = 8; eql = 9;
  38.         neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  39.         in = 15; is = 16; ash = 17; msk = 18; len = 19;
  40.         conv = 20; abs = 21; cap = 22; odd = 23; not = 33;
  41.         (* SYSTEM *)
  42.         adr = 24; cc = 25; bit = 26; lsh = 27; rot = 28; val = 29;
  43.         (* structure forms *)
  44.         Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  45.         Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  46.         Pointer = 13; ProcTyp = 14; Comp = 15;
  47.         (* composite structure forms *)
  48.         Basic = 1; Array = 2; DynArr = 3; Record = 4;
  49.         intSet = { SInt, Int, LInt }; realSet = { Real, LReal };
  50.         (* node classes *)
  51.         Nvar = 0; Nvarpar = 1; Nfield = 2; Nderef = 3; Nindex = 4; Nguard = 5; Neguard = 6;
  52.         Nconst = 7; Ntype = 8; Nproc = 9; Nupto = 10; Nmop = 11; Ndop = 12; Ncall = 13;
  53.         Ninittd = 14; Nif = 15; Ncaselse = 16; Ncasedo = 17; Nenter = 18; Nassign = 19;
  54.         Nifelse =20; Ncase = 21; Nwhile = 22; Nrepeat = 23; Nloop = 24; Nexit = 25;
  55.         Nreturn = 26; Nwith = 27; Ntrap = 28;
  56.         (* function numbers *)
  57.         assign = 0; newfn = 1; incfn = 13; decfn = 14;
  58.         inclfn = 15; exclfn = 16; copyfn = 18; assertfn = 32;
  59.         (* SYSTEM function numbers *)
  60.         getfn = 24; putfn = 25; getrfn = 26; putrfn = 27; sysnewfn = 30; movefn = 31; callfn = 33;        (*<<OJ*)
  61.         VarParSize = OPM.PointerSize;
  62.         RecVarParSize = 2 * OPM.PointerSize;
  63.         ProcOff = 8;
  64.         (* procedure flags *)
  65.         hasBody = 1; isRedef = 2;
  66.         (* accessibility of objects *)
  67.         internal = 0; external = 1; externalR = 2;
  68.         (* trap numbers *)
  69.         WithTrap = 15;
  70.         CaseTrap = 16;
  71.         FuncTrap = 17;
  72.     VAR assert, findpc, typCheck : BOOLEAN;
  73.             loopEnd : OPL.Label;
  74.     PROCEDURE Init*( opt : SET; bpc : LONGINT );
  75.         CONST ass = 7; fpc = 8; typchk = 3;
  76.     BEGIN
  77.         typCheck := typchk IN opt;
  78.         assert := ass IN opt;
  79.         findpc := fpc IN opt;
  80.         IF findpc THEN OPM.breakpc := bpc ELSE OPM.breakpc := MAX( LONGINT ) END
  81.     END Init;
  82.     PROCEDURE Base( typ : OPT.Struct ) : INTEGER;
  83.     (* Returns the alignment of a type. *)
  84.     BEGIN
  85.         WHILE typ.comp = Array DO typ := typ.BaseTyp END;
  86.         IF typ.form IN { Byte, Bool, Char, SInt } THEN RETURN 1
  87.         ELSE RETURN 2
  88.         END
  89.     END Base;
  90.     PROCEDURE Align( VAR adr : LONGINT; base : LONGINT );
  91.     (* Aligns the given address with the given base. *)
  92.     BEGIN
  93.         IF adr > 0 THEN 
  94.             INC( adr, ( -adr ) MOD base );
  95.         ELSE
  96.             DEC( adr, adr MOD base );
  97.         END;
  98.     END Align;
  99.     PROCEDURE ^TypSize*( typ : OPT.Struct; dummy : BOOLEAN );
  100.     PROCEDURE ParamAdr( par : OPT.Object; VAR psize : LONGINT );
  101.     (* Calculates the sizes of the parameters of a procedure and returns their sum in psize. *)
  102.         VAR typ : OPT.Struct;
  103.                 c : INTEGER;
  104.     BEGIN (* ParamAdr *)
  105.         WHILE par # NIL DO
  106.             typ := par.typ; c := typ.comp;
  107.             TypSize( typ, FALSE );
  108.             IF par.mode = VarPar THEN
  109.                 par.adr := psize;
  110.                 IF c = Record THEN INC( psize, RecVarParSize )
  111.                 ELSIF c = DynArr THEN INC( psize, typ.size )
  112.                 ELSE INC( psize, VarParSize )
  113.                 END;
  114.             ELSE
  115.                 IF typ.form IN {Byte, Bool, Char, SInt, Int} THEN
  116.                     INC( psize, OPM.LIntSize );
  117.                 ELSE
  118.                     INC( psize, typ.size );
  119.                 END;
  120.                 par.adr := psize - typ.size;
  121.                 par.linkadr := par.adr;
  122.             END; (* IF *)
  123.             Align( psize, 4 ); (* all parameters are aligned to 4 bytes. *)
  124.             par := par.link;
  125.         END; (* WHILE *)
  126.     END ParamAdr;
  127.     PROCEDURE ^VarAdr( var : OPT.Object; VAR dsize : LONGINT );
  128.     PROCEDURE ^Traverse( obj : OPT.Object; exported : BOOLEAN );
  129.     PROCEDURE ProcSize( obj : OPT.Object; firstpass : BOOLEAN );
  130.     (* Writes the size of the local variables into the field obj.conval.intval and calculates the addresses of all parameters. *)
  131.         VAR oldPos : LONGINT;
  132.                 conval: OPT.Const;
  133.                 typ : OPT.Struct;
  134.                 redef : OPT.Object;
  135.     BEGIN (* ProcSize *)
  136.         conval := obj.conval;
  137.         oldPos := OPM.errpos;
  138.         OPM.errpos := obj.scope.adr;
  139.         IF ( ( obj.vis # internal ) = firstpass ) OR ( obj.mode = TProc ) THEN
  140.             obj.adr := -1;
  141.             obj.linkadr := OPL.NewLabel;
  142.             IF obj.mode IN { XProc, IProc, TProc } THEN
  143.                 IF OPL.entno < OPL.MaxEntry THEN
  144.                     obj.adr := OPL.entno;
  145.                     INC( OPL.entno );
  146.                 ELSE
  147.                     OPM.err( 226 );
  148.                     obj.adr := 1;
  149.                 END;
  150.             END;
  151.             IF obj.mnolev > 0 THEN
  152.                 conval.intval2 := ProcOff + OPM.PointerSize; (* for static link *)
  153.             ELSE
  154.                 conval.intval2 := ProcOff;
  155.             END;
  156.             ParamAdr( obj.link, conval.intval2 );
  157.             IF obj.mode = TProc THEN
  158.                 typ := obj.link.typ;
  159.                 IF typ.form = Pointer THEN typ := typ.BaseTyp END;
  160.                 OPT.FindField( obj.name, typ.BaseTyp, redef );
  161.                 IF redef # NIL THEN
  162.                     obj.adr := 10000H * ( redef.adr DIV 10000H ) (* mthno *) + obj.adr (* entno *);
  163.                     IF ~( isRedef IN obj.conval.setval ) THEN OPM.err( 134 ) END;
  164.                 ELSE
  165.                     INC( obj.adr, 10000H * typ.n );
  166.                     INC( typ.n );
  167.                 END; (* IF *)
  168.             END; (* IF *)
  169.         END; (* IF *)
  170.         IF ~firstpass THEN
  171.             IF ~( hasBody IN conval.setval ) THEN OPM.err( 129 ) END;
  172.             conval.intval := 0;
  173.             VarAdr( obj.scope.scope, conval.intval ); (* local variables *)
  174.             Traverse( obj.scope.right, FALSE ); (* local types and procedures *)
  175.         END;
  176.         OPM.errpos := oldPos
  177.     END ProcSize;
  178.     PROCEDURE TypSize*( typ : OPT.Struct; dummy : BOOLEAN );
  179.     (* Writes the size of a type into typ.size. All subordinate type sizes are calculated, all record fields get an offset. *)
  180.         VAR offset, size : LONGINT;
  181.                 fld : OPT.Object;
  182.                 btyp : OPT.Struct;
  183.     BEGIN (* TypSize *)
  184.         IF typ.size = -1 THEN
  185.             CASE typ.form OF
  186.                 Pointer : 
  187.                     typ.size := OPM.PointerSize;
  188.                     IF typ.BaseTyp = OPT.undftyp THEN
  189.                         OPM.Mark( 128, typ.n );
  190.                     ELSE
  191.                         TypSize( typ.BaseTyp, FALSE );
  192.                     END;
  193.                 | ProcTyp :
  194.                     size := ProcOff; typ.size := OPM.ProcSize;
  195.                     ParamAdr( typ.link, size ); (* inserts the addresses of the parameters. *)
  196.                 | Comp :
  197.                     CASE typ.comp OF
  198.                         Record :
  199.                             btyp := typ.BaseTyp;
  200.                             IF btyp = NIL THEN
  201.                                 offset := 0;
  202.                             ELSE
  203.                                 TypSize( btyp, FALSE );
  204.                                 offset := btyp.size;
  205.                             END;
  206.                             fld := typ.link;
  207.                             WHILE ( fld # NIL ) & ( fld.mode = Fld ) DO
  208.                                 btyp := fld.typ;
  209.                                 TypSize( btyp, FALSE );
  210.                                 size := btyp.size;
  211.                                 Align( offset, Base( btyp ) );
  212.                                 fld.adr := offset;
  213.                                 INC( offset, size );
  214.                                 fld := fld.link
  215.                             END; (* WHILE *)
  216.                             Align( offset, 2 ); (* all records are at least 2 Bytes long *)
  217.                             typ.size := offset;
  218.                         | Array :
  219.                             TypSize( typ.BaseTyp, FALSE ); 
  220.                             typ.size := typ.n * typ.BaseTyp.size;
  221.                         | DynArr :
  222.                             btyp := typ.BaseTyp;
  223.                             IF typ.offset < 0 THEN typ.offset := typ.n; END;
  224.                             IF btyp.comp = DynArr THEN btyp.offset := typ.n; END;
  225.                             TypSize( btyp, FALSE );
  226.                             IF btyp.comp = DynArr THEN
  227.                                 typ.size := btyp.size + 4;
  228.                             ELSE
  229.                                 typ.size := 8;
  230.                             END;
  231.                     END; (* CASE *)
  232.             ELSE (* nothing *)
  233.             END; (* CASE typ.form *)
  234.         END; (* IF *)
  235.     END TypSize;
  236.     PROCEDURE VarAdr( var : OPT.Object; VAR dsize : LONGINT );
  237.     (* Inserts entry-numbers and addresses into the variables. Exported variables are entered into the entry list. *)
  238.         VAR typ: OPT.Struct; adr: LONGINT;
  239.     BEGIN
  240.         adr := -dsize;
  241.         WHILE var # NIL DO
  242.             typ := var.typ;
  243.             TypSize( typ, FALSE );
  244.             DEC( adr, typ.size );
  245.             IF typ.form = Comp THEN
  246.                 Align( adr, 4 );
  247.             ELSE
  248.                 Align( adr, Base( typ ) );
  249.             END; (* IF *)
  250.             IF var.vis = internal THEN
  251.                 var.adr := adr;
  252.             ELSE
  253.                 OPL.SetEntry( OPL.entno, adr );
  254.                 var.adr := OPL.entno;
  255.                 INC( OPL.entno );
  256.             END; (* IF *)
  257.             var.linkadr := adr;
  258.             var := var.link
  259.         END; (* WHILE *)
  260.         dsize := -adr;
  261.         Align( dsize, 8 );
  262.     END VarAdr;
  263.     PROCEDURE Traverse( obj : OPT.Object; exported : BOOLEAN );
  264.     (* Completes types and procedures. *)
  265.         VAR typ: OPT.Struct;
  266.         PROCEDURE TraverseRecord( typ : OPT.Struct );
  267.         (* Inserts the type descriptor address into the types and the method numbers into the methods. *)
  268.         BEGIN
  269.             IF typ.tdadr = OPM.TDAdrUndef THEN
  270.                 IF typ.BaseTyp # NIL THEN
  271.                     TraverseRecord( typ.BaseTyp );
  272.                     typ.n := typ.BaseTyp.n;
  273.                 END; (* IF *)
  274.                 Traverse( typ.link, FALSE ); (* traverse methods *)
  275.                 OPL.AllocTypDesc( typ );
  276.             END; (* IF *)
  277.         END TraverseRecord;
  278.     BEGIN (* Traverse *)
  279.         IF obj # NIL THEN
  280.             Traverse( obj.left, exported );
  281.             IF ( obj.mode = Typ ) & ( ( obj.vis # internal ) = exported ) THEN
  282.                 typ := obj.typ;
  283.                 TypSize( typ, FALSE );
  284.                 IF typ.form = Pointer THEN typ := typ.BaseTyp END;
  285.                 IF typ.comp = Record THEN TraverseRecord( typ ) END;
  286.             ELSIF obj.mode IN {LProc, XProc, TProc, CProc, IProc} THEN
  287.                 ProcSize( obj, exported )
  288.             END ;
  289.             Traverse( obj.right, exported )
  290.         END
  291.     END Traverse;
  292.     PROCEDURE AdrAndSize*;
  293.     (* Completes the symbol table: types, variables, record-fields and procedures. *)
  294.     BEGIN (* AdrAndSize *)
  295.         OPL.dsize := 0;
  296.         VarAdr( OPT.topScope.scope, OPL.dsize );
  297.         OPM.errpos := OPT.topScope.adr;    (* text position of the scope *)
  298.         Traverse( OPT.topScope.right, TRUE );  (* first run for all exported types and procedures *)
  299.         Traverse( OPT.topScope.right, FALSE );  (* second run for all local types and procedures *)
  300.     END AdrAndSize;
  301.     PROCEDURE BaseTyp( typ : OPT.Struct ) : OPT.Struct;
  302.     (* Returns the record type belonging to typ. *)
  303.     BEGIN (* BaseTyp *)
  304.         IF typ.form = Pointer THEN RETURN typ.BaseTyp
  305.         ELSE RETURN typ
  306.         END
  307.     END BaseTyp;
  308.     PROCEDURE ^Expr( node : OPT.Node; VAR res : OPL.Item );
  309.     PROCEDURE Designator( node : OPT.Node; VAR res : OPL.Item );
  310.     (* Returns an item for a designator. res.mode is in { regx, pcx }. *)
  311.         VAR index, tag : OPL.Item;
  312.     BEGIN (* Designator *)
  313.         CASE node.class OF
  314.             Nvar, Nvarpar :
  315.                 OPC.MakeVar( node.obj, res );
  316.             | Nfield :
  317.                 Designator( node.left, res );
  318.                 OPC.MakeField( res, node.obj.adr, node.typ );
  319.             | Nderef :
  320.                 Designator( node.left, res );
  321.                 OPC.DeRef( node.typ, res );
  322.             | Nindex :
  323.                 Expr( node.right, index );
  324.                 Designator( node.left, res );
  325.                 OPC.MakeIndex( index, res );
  326.             | Nguard, Neguard :
  327.                 Designator( node.left, res );
  328.                 IF typCheck THEN
  329.                     OPC.saveRegs:=FALSE;
  330.                     OPC.MakeTag( node.left.obj, node.left.typ, res, tag );
  331.                     OPC.TypeTest( tag, BaseTyp( node.typ ), TRUE, node.class = Neguard );
  332.                     OPC.saveRegs:=TRUE;
  333.                 END; (* IF *)
  334.             | Nproc :
  335.                 OPC.MakeProc( node.obj, node.subcl, res );
  336.         END; (* CASE *)
  337.         res.typ := node.typ;
  338.     END Designator;
  339.     PROCEDURE AllocParams( formalPar : OPT.Object; VAR psize : LONGINT );
  340.     (* Allocates space on the stack for the parameters and increments psize by their size. *)
  341.     BEGIN (* AllocParams *)
  342.         WHILE formalPar # NIL DO
  343.             IF formalPar.mode = VarPar THEN
  344.                 IF formalPar.typ.comp = Record THEN INC( psize, RecVarParSize )
  345.                 ELSIF formalPar.typ.comp = DynArr THEN INC( psize, formalPar.typ.size )
  346.                 ELSE INC( psize, VarParSize )
  347.                 END;
  348.             ELSE
  349.                 INC( psize, formalPar.typ.size );
  350.             END; (* IF *)
  351.             Align( psize, 4 );
  352.             formalPar := formalPar.link;
  353.         END; (* WHILE *)
  354.         OPC.AddToSP( -psize );
  355.     END AllocParams;
  356.     PROCEDURE AssignParams( formalPar : OPT.Object; actualPar : OPT.Node );
  357.     (* Moves the actual parameters to the stack. *)
  358.         VAR par, par1, tag : OPL.Item;
  359.     BEGIN (* AssignParams *)
  360.         WHILE formalPar # NIL DO
  361.             IF formalPar.typ.comp = DynArr THEN
  362.                 Expr( actualPar, par );
  363.                 OPC.MoveDynArrStack( formalPar.typ, formalPar.adr - ProcOff, par );
  364.             ELSIF formalPar.mode = VarPar THEN
  365.                 Designator( actualPar, par );
  366.                 par1 := par;
  367.                 OPC.MoveAdrStack( formalPar.adr - ProcOff, par );
  368.                 IF formalPar.typ.comp = Record THEN
  369.                     OPC.MakeTag( actualPar.obj, actualPar.typ, par, tag );
  370.                     OPC.MoveStack( formalPar.adr + 4 - ProcOff, tag );
  371.                 ELSIF ( formalPar.typ = OPT.sysptrtyp ) & ( actualPar.typ # OPT.sysptrtyp ) THEN
  372.                     (* pass static type to enable run time tests *)
  373.                     OPC.StaticTag( actualPar.typ.BaseTyp, tag );
  374.                     OPC.Assign( tag, par1 );
  375.                 ELSIF ( formalPar.typ = OPT.sysptrtyp ) & ( actualPar.typ = OPT.sysptrtyp ) & ( actualPar.obj.mode # VarPar ) THEN
  376.                     (* pass NIL to disable run time tests *)
  377.                     OPC.MakeIntConst( 0, OPT.linttyp, tag );
  378.                     OPC.Assign( tag, par1 );
  379.                 END; (* IF *)
  380.             ELSE
  381.                 par.tJump := OPL.NewLabel;
  382.                 par.fJump := OPL.NewLabel;
  383.                 Expr( actualPar, par );
  384.                 OPC.Convert( par, formalPar.typ );
  385.                 OPC.MoveStack( formalPar.adr - ProcOff, par );
  386.             END; (* IF *)
  387.             OPL.usedRegs := { };
  388.             actualPar := actualPar.link;
  389.             formalPar := formalPar.link;
  390.         END; (* WHILE *)
  391.     END AssignParams;
  392.     PROCEDURE Expr( node : OPT.Node; VAR res : OPL.Item );
  393.     (* Returns an item for the result of an exression. *)
  394.         VAR expr1, expr2, expression, set, element, procItem, arr, tag : OPL.Item;
  395.                 swap : OPL.Label;
  396.                 savedRegs : SET;
  397.                 psize: LONGINT;
  398.                 Dummy: SHORTINT;
  399.     BEGIN (* Expr *)
  400.         CASE node.class OF
  401.             Nconst :
  402.                 OPC.MakeConst( node.obj, node.conval, node.typ, res );
  403.             | Nupto :
  404.                 Expr( node.left, expr1 );
  405.                 Expr( node.right, expr2 );
  406.                 OPC.UpTo( expr1, expr2, res );
  407.             | Nmop :
  408.                 CASE node.subcl OF
  409.                     not :
  410.                         swap := res.tJump;
  411.                         res.tJump := res.fJump;
  412.                         res.fJump := swap;
  413.                         Expr( node.left, res );
  414.                         swap := res.tJump;
  415.                         res.tJump := res.fJump;
  416.                         res.fJump := swap;
  417.                         OPC.Not( res );
  418.                     | minus :
  419.                         Expr( node.left, res );
  420.                         OPC.Neg( res );
  421.                     | is :
  422.                         Designator( node.left, res );
  423.                         tag.tJump := res.tJump;
  424.                         tag.fJump := res.fJump;
  425.                         OPC.saveRegs:=FALSE;
  426.                         OPC.MakeTag( node.left.obj, node.left.typ, res, tag );
  427.                         OPC.TypeTest( tag, BaseTyp( node.obj.typ ), FALSE, FALSE );
  428.                         OPC.saveRegs:=TRUE;
  429.                         res := tag;
  430.                     | conv :
  431.                         Expr( node.left, res );
  432.                         IF node.typ.form = Set THEN
  433.                             OPC.SetElem( res );
  434.                         ELSE
  435.                             OPC.Convert( res, node.typ );
  436.                         END; (* IF *)
  437.                     | abs :
  438.                         Expr( node.left, res );
  439.                         OPC.Abs( res );
  440.                     | cap :
  441.                         Expr( node.left, res );
  442.                         OPC.Cap( res );
  443.                     | odd :
  444.                         Expr( node.left, res );
  445.                         OPC.Odd( res );
  446.                     | adr :
  447.                         Expr( node.left, res );
  448.                         OPC.Adr( res );
  449.                     | cc :
  450.                         OPC.MakeCocItem( SHORT( node.left.conval.intval ), res );
  451.                     | val :
  452.                         res.tJump := OPL.NewLabel;
  453.                         res.fJump := OPL.NewLabel;
  454.                         Expr( node.left, res );
  455.                         IF res.typ.comp = DynArr THEN OPC.GetDynArrVal( res ); END;
  456.                         res.typ := node.typ;
  457.                 END; (* CASE *)
  458.             | Ndop :
  459.                 CASE node.subcl OF
  460.                     times :
  461.                         Expr( node.left, expression );
  462.                         Expr( node.right, res );
  463.                         OPC.Mul( node.typ, expression, res );
  464.                     | slash :
  465.                         Expr( node.left, res );
  466.                         Expr( node.right, expression );
  467.                         OPC.Divide( node.typ, expression, res );
  468.                     | div :
  469.                         Expr( node.left, res );
  470.                         Expr( node.right, expression );
  471.                         OPC.Div( expression, res );
  472.                     | mod :
  473.                         Expr( node.left, res );
  474.                         Expr( node.right, expression );
  475.                         OPC.Mod( expression, res );
  476.                     | and :
  477.                         savedRegs := OPL.usedRegs;
  478.                         expression.tJump := OPL.NewLabel;
  479.                         expression.fJump := res.fJump;
  480.                         Expr( node.left, expression );
  481.                         OPC.FalseJump( expression, expression.fJump );
  482.                         OPL.usedRegs := savedRegs;
  483.                         Expr( node.right, res );
  484.                         OPC.Test( res );
  485.                         res.fJump := OPL.MergedLinks( expression.fJump, res.fJump );
  486.                     | plus :
  487.                         Expr( node.left, res );
  488.                         Expr( node.right, expression );
  489.                         OPC.Plus( node.typ, expression, res );
  490.                     | minus :
  491.                         Expr( node.left, res );
  492.                         Expr( node.right, expression );
  493.                         OPC.Minus( node.typ, expression, res );
  494.                     | or : 
  495.                         savedRegs := OPL.usedRegs;
  496.                         expression.tJump := res.tJump;
  497.                         expression.fJump := OPL.NewLabel;
  498.                         Expr( node.left, expression );
  499.                         OPC.TrueJump( expression, expression.tJump );
  500.                         OPL.usedRegs := savedRegs;
  501.                         Expr( node.right, res );
  502.                         OPC.Test( res );
  503.                         res.tJump := OPL.MergedLinks( expression.tJump, res.tJump );
  504.                     | eql, neq, lss, leq, gtr, geq :
  505.                         expr1.tJump := OPL.NewLabel;
  506.                         expr1.fJump := OPL.NewLabel;
  507.                         expr2.tJump := OPL.NewLabel;
  508.                         expr2.fJump := OPL.NewLabel;
  509.                         Expr( node.left, expr1 );
  510.                         OPC.LoadCC( expr1 );
  511.                         Expr( node.right, expr2 );
  512.                         OPC.Compare( node.subcl, expr1, expr2, res );
  513.                     | in :
  514.                         Expr( node.left, element );
  515.                         Expr( node.right, set );
  516.                         OPC.In( element, set, res );
  517.                     | ash :
  518.                         Expr( node.left, res );
  519.                         Expr( node.right, expression );
  520.                         OPC.Shift( ASh, expression, res );
  521.                     | msk :
  522.                         Expr( node.left, res );
  523.                         OPC.Mask( -node.right.conval.intval-1, res );
  524.                     | len :
  525.                         Designator( node.left, arr );
  526.                         OPC.MakeLen( arr, node.right.conval.intval, res );
  527.                     | bit :
  528.                         Expr( node.left, expr1 );
  529.                         Expr( node.right, expr2 );
  530.                         OPC.SYSBit( expr1, expr2, res );
  531.                     | lsh :
  532.                         Expr( node.left, res );
  533.                         Expr( node.right, expression );
  534.                         OPC.Shift( LSh, expression, res );
  535.                     | rot :
  536.                         Expr( node.left, res );
  537.                         Expr( node.right, expression );
  538.                         OPC.Shift( ROt, expression, res );
  539.                 END; (* CASE *)
  540.             | Ncall :
  541.                 savedRegs := OPL.usedRegs;
  542.                 OPC.PushRegs( OPL.usedRegs );
  543.                 OPL.usedRegs := { };
  544.                 IF ( node.left.obj # NIL ) & ( node.left.obj.mode = LProc ) & ( node.left.obj.mnolev > 0 ) THEN
  545.                     psize := OPM.PointerSize; (* for static link *)
  546.                 ELSE
  547.                     psize := 0;
  548.                 END;
  549.                 AllocParams( node.obj, psize );
  550.                 OPC.WriteStaticLink( node.left.obj );
  551.                 AssignParams( node.obj, node.right );
  552.                 Designator( node.left, procItem );
  553.                 OPC.Call( procItem, node.left.obj );
  554.                 OPC.AddToSP( psize );
  555.                 OPL.usedRegs := savedRegs;
  556.                 Dummy:=node.left.typ.form;
  557.                 node.left.typ.form:=node.typ.form;
  558.                 OPC.GetResult( node.left.typ, res );
  559.                 node.left.typ.form:=Dummy;
  560.                 OPC.PopRegs( savedRegs );
  561.         ELSE
  562.             Designator( node, res );
  563.         END; (* CASE *)
  564.         res.typ := node.typ;
  565.     END Expr;
  566.     PROCEDURE Checkpc;
  567.     BEGIN
  568.         IF findpc & (OPL.pc > OPM.breakpc) & OPM.noerr THEN OPM.err(255) END
  569.         (* in the case of a call, the breakpc value shown in the trap viewer must point to the call instruction
  570.             and not to the next instruction, i.e. breakpc # return address !! *)
  571.     END Checkpc;
  572.     PROCEDURE StatSeq( node : OPT.Node );
  573.     (* Generates code for a statement sequence. *)
  574.         VAR proc : OPT.Object;
  575.                 designator, expression, sourceAdr, destAdr, procItem, reg, tag : OPL.Item;
  576.                 begLabel, savedLoopEnd : OPL.Label;
  577.                 psize : LONGINT;
  578.         PROCEDURE CaseStatement( node : OPT.Node );
  579.         (* Generates code for a case statement. *)
  580.             VAR expression : OPL.Item;
  581.                     lo, hi, i, jtAdr : LONGINT;
  582.                     elseLabel, endLabel : OPL.Label;
  583.                     case, caseLabel : OPT.Node;
  584.         BEGIN (* CaseStatement *)
  585.             Expr( node.left, expression );
  586.             node := node.right;
  587.             lo := node.conval.intval;
  588.             hi := node.conval.intval2;
  589.             IF hi >= lo THEN
  590.                 elseLabel := OPL.NewLabel;
  591.                 endLabel := OPL.NewLabel;
  592.                 OPC.Case( expression, lo, hi, elseLabel, jtAdr );
  593.                 FOR i := 0 TO hi - lo DO OPL.ConstWord( SHORT( jtAdr + 2 * i ), OPL.pc DIV 2 ); END;
  594.                 OPL.DefineLabel( elseLabel );
  595.             END; (* IF *)
  596.             Checkpc;
  597.             IF node.conval.setval = { } THEN
  598.                 OPC.Trap( CaseTrap );
  599.             ELSE
  600.                 StatSeq( node.right );
  601.             END;
  602.             IF hi >= lo THEN
  603.                 case := node.left;
  604.                 WHILE case # NIL DO
  605.                     OPL.Jump( true, endLabel );
  606.                     caseLabel := case.left;
  607.                     WHILE caseLabel # NIL DO
  608.                         FOR i := caseLabel.conval.intval - lo TO caseLabel.conval.intval2 - lo DO
  609.                             OPL.ConstWord( SHORT( jtAdr + 2 * i ), OPL.pc DIV 2 ); 
  610.                         END; (* FOR *)
  611.                         caseLabel := caseLabel.link;
  612.                     END; (* WHILE *)
  613.                     StatSeq( case.right );
  614.                     case := case.link;
  615.                 END; (* WHILE *)
  616.                 OPL.DefineLabel( endLabel );
  617.             END; (* IF *)
  618.         END CaseStatement;
  619.         PROCEDURE IfStatement( node : OPT.Node; trap : BOOLEAN );
  620.         (* Generates code for an IF-Statement. If trap is true, a Trap is generated in the ELSE-Case. *)
  621.             VAR endLabel : OPL.Label;
  622.                     curNode : OPT.Node;
  623.                     expression : OPL.Item;
  624.         BEGIN (* IfStatement *)
  625.             endLabel := OPL.NewLabel;
  626.             curNode := node.left;
  627.             WHILE curNode # NIL DO
  628.                 expression.tJump := OPL.NewLabel;
  629.                 expression.fJump := OPL.NewLabel;
  630.                 Expr( curNode.left, expression );
  631.                 OPC.FalseJump( expression, expression.fJump ); Checkpc;
  632.                 StatSeq( curNode.right );
  633.                 IF ( curNode.link # NIL ) OR ( node.right # NIL ) OR trap THEN
  634.                 (* last ELSIF part with no ELSE following *)
  635.                     OPL.Jump( true, endLabel );
  636.                 END;
  637.                 OPL.DefineLabel( expression.fJump );
  638.                 curNode := curNode.link;
  639.             END; (* WHILE *)
  640.             IF trap THEN
  641.                 OPC.Trap( WithTrap );
  642.             ELSE
  643.                 StatSeq( node.right );
  644.             END; (* IF *)
  645.             OPL.DefineLabel( endLabel );
  646.         END IfStatement;
  647.         PROCEDURE Size( typ : OPT.Struct; node : OPT.Node; VAR res : OPL.Item );
  648.         (* Returns an item that denotes the size of the memory space in bytes that has to be allocated for a dynamic array. *)
  649.             VAR dim, offsetItem : OPL.Item;
  650.                     noflen : INTEGER;
  651.         BEGIN (* Size *)
  652.             Expr( node, res );
  653.             noflen := 1;
  654.             node := node.link;
  655.             typ := typ.BaseTyp.BaseTyp;
  656.             WHILE node # NIL DO
  657.                 Expr( node, dim );
  658.                 INC( noflen );
  659.                 OPC.Mul( OPT.linttyp, dim, res );
  660.                 node := node.link;
  661.                 typ := typ.BaseTyp;
  662.             END; (* WHILE *)
  663.             IF typ.size > 1 THEN
  664.                 OPC.MakeIntConst( typ.size, OPT.linttyp, dim );
  665.                 OPC.Mul( OPT.linttyp, dim, res );
  666.             END; (* IF *)
  667.             OPC.MakeIntConst( 4 * noflen, OPT.linttyp, offsetItem );
  668.             OPC.Plus( OPT.linttyp, offsetItem, res );
  669.         END Size;
  670.         PROCEDURE EnterLengths( VAR item : OPL.Item; node : OPT.Node );
  671.         (* Writes the lengths in node to the address in item. Used for NEW( p, len1, len2, ... ). *)
  672.             VAR length, adr : OPL.Item;
  673.         BEGIN (* EnterLengths *)
  674.             adr := item;
  675.             OPC.DeRef( OPT.sysptrtyp, adr );
  676.             WHILE node # NIL DO
  677.                 Expr( node, length );
  678.                 OPC.Convert( length, OPT.linttyp );
  679.                 OPL.Move( length, adr );
  680.                 INC( adr.bd, 4 );
  681.                 node := node.link;
  682.             END; (* WHILE *)
  683.         END EnterLengths;
  684.         PROCEDURE Prepend( s : ARRAY OF CHAR );
  685.         (* Writes the given name in parentheses to the reference file. *)
  686.             VAR i : INTEGER;
  687.                     ch : CHAR;
  688.         BEGIN (* Prepend *)
  689.             i := 0;
  690.             ch := s[ 0 ];
  691.             OPM.RefW( "(" );
  692.             WHILE ch # 0X DO
  693.                 OPM.RefW( ch );
  694.                 INC( i );
  695.                 ch := s[ i ];
  696.             END; (* WHILE *)
  697.             OPM.RefW( ")" );
  698.         END Prepend;
  699.     BEGIN (* StatSeq *)
  700.         WHILE ( node # NIL ) & OPM.noerr DO
  701.             OPM.errpos := node.conval.intval;
  702.             OPL.BegStat;
  703.             CASE node.class OF
  704.                 Nenter :
  705.                     IF node.obj = NIL THEN (* module *)
  706.                         OPC.EnterMod;
  707.                         StatSeq( node.right );
  708.                         OPC.Return( NIL, FALSE, expression );
  709.                         OPL.OutRefPoint;
  710.                         OPL.OutRefName( "$" );
  711.                         OPL.OutRefs( OPT.topScope );
  712.                         INC( OPL.level );
  713.                         StatSeq( node.left );
  714.                         DEC( OPL.level );
  715.                     ELSE (* procedure *)
  716.                         proc := node.obj;
  717.                         INC( OPL.level );
  718.                         StatSeq( node.left );
  719.                         DEC( OPL.level );
  720.                         OPC.EnterProc( proc );
  721.                         StatSeq( node.right );
  722.                         IF proc.typ # OPT.notyp THEN OPC.Trap( FuncTrap );
  723.                         ELSE OPC.Return( proc, FALSE, expression );
  724.                         END;
  725.                         OPL.OutRefPoint;
  726.                         IF proc^.mode = TProc THEN Prepend( proc^.link^.typ^.strobj^.name ) END;
  727.                         OPL.OutRefName( proc^.name );
  728.                         OPL.OutRefs( proc^.scope^.right );
  729.                     END; (* IF *)
  730.                 | Ninittd :
  731.                 | Nassign :
  732.                     CASE node.subcl OF
  733.                         assign :
  734.                             expression.tJump := OPL.NewLabel;
  735.                             expression.fJump := OPL.NewLabel;
  736.                             Expr( node.right, expression );
  737.                             OPC.LoadCC( expression );
  738.                             Designator( node.left, designator );
  739.                             OPC.Assign( expression, designator );
  740.                         | newfn :
  741.                             Designator( node.left, designator );
  742.                             OPL.LoadAdr( designator );
  743.                             IF node.right = NIL THEN
  744.                                 IF node.left.typ.BaseTyp.comp = Record THEN
  745.                                     OPC.StaticTag( node.left.typ.BaseTyp, tag );
  746.                                     OPC.New( designator, tag );
  747.                                 ELSE
  748.                                     OPC.MakeIntConst( node.left.typ.BaseTyp.size, OPT.linttyp, expression );
  749.                                     OPC.SYSNew( designator, expression );
  750.                                 END; (* IF *)
  751.                             ELSE
  752.                                 Size( node.left.typ, node.right, expression );
  753.                                 OPC.SYSNew( designator, expression );
  754.                                 EnterLengths( designator, node.right );
  755.                             END; (* IF *)
  756.                         | incfn :
  757.                             Expr( node.right, expression );
  758.                             Designator( node.left, designator );
  759.                             OPL.LoadAdr( designator );
  760.                             OPC.Increment( designator, expression );
  761.                         | decfn :
  762.                             Expr( node.right, expression );
  763.                             Designator( node.left, designator );
  764.                             OPL.LoadAdr( designator );
  765.                             OPC.Decrement( designator, expression );
  766.                         | inclfn :
  767.                             Expr( node.right, expression );
  768.                             Designator( node.left, designator );
  769.                             OPL.LoadAdr( designator );
  770.                             OPC.Include( designator, expression );
  771.                         | exclfn :
  772.                             Expr( node.right, expression );
  773.                             Designator( node.left, designator );
  774.                             OPL.LoadAdr( designator );
  775.                             OPC.Exclude( designator, expression );
  776.                         | copyfn :
  777.                             Expr( node.right, expression );
  778.                             Designator( node.left, designator );
  779.                             OPC.Copy( expression, designator );
  780.                         | getfn :
  781.                             Expr( node.right, sourceAdr );
  782.                             Designator( node.left, designator );
  783.                             OPL.LoadAdr( designator );
  784.                             OPC.SYSGet( sourceAdr, designator );
  785.                         | putfn :
  786.                             Expr( node.left, destAdr );
  787.                             Expr( node.right, expression );
  788.                             OPC.SYSPut( expression, destAdr );
  789.                         | getrfn :
  790.                             OPC.MakeConst( node.obj, node.right.conval, OPT.inttyp, reg );
  791.                             Designator( node.left, designator );
  792.                             OPL.LoadAdr( designator );
  793.                             OPC.SYSGetReg( designator, reg );
  794.                         | putrfn :
  795.                             OPC.MakeConst( node.obj, node.left.conval, OPT.inttyp, reg );
  796.                             Expr( node.right, expression );
  797.                             OPC.SYSPutReg( expression, reg );
  798.                         | sysnewfn :
  799.                             Designator( node.left, designator );
  800.                             OPL.LoadAdr( designator );
  801.                             Expr( node.right, expression );
  802.                             OPC.SYSNew( designator, expression );
  803.                         | movefn :
  804.                             Expr( node.left, sourceAdr );
  805.                             Expr( node.right, destAdr );
  806.                             Expr( node.right.link, expression );
  807.                             OPC.SYSMove( destAdr, sourceAdr, expression );
  808.                         | callfn :        (*<<OJ*)
  809.                             OPC.MakeConst( node.obj, node.left.conval, OPT.inttyp, reg );
  810.                             Expr( node.right, expression );
  811.                             OPC.SYSCall( expression, reg );
  812.                     END; (* CASE *)
  813.                 | Ncall :
  814.                     IF ( node.left.obj # NIL ) & ( node.left.obj.mode = LProc ) & ( node.left.obj.mnolev > 0 ) THEN
  815.                         psize := OPM.PointerSize; (* for static link *)
  816.                     ELSE
  817.                         psize := 0;
  818.                     END;
  819.                     AllocParams( node.obj, psize );
  820.                     OPC.WriteStaticLink( node.left.obj );
  821.                     AssignParams( node.obj, node.right );
  822.                     Designator( node.left, procItem );
  823.                     OPC.Call( procItem, node.left.obj );
  824.                     OPC.AddToSP( psize );
  825.                 | Nifelse :
  826.                     IF ( node^.subcl # assertfn ) OR assert THEN IfStatement( node, FALSE ); END;
  827.                 | Ncase :
  828.                     CaseStatement( node );
  829.                 | Nwhile :
  830.                     begLabel := OPL.NewLabel;
  831.                     OPL.DefineLabel( begLabel );
  832.                     expression.tJump := OPL.NewLabel;
  833.                     expression.fJump := OPL.NewLabel;
  834.                     Expr( node.left, expression );
  835.                     OPC.FalseJump( expression, expression.fJump );
  836.                     StatSeq( node.right );
  837.                     OPL.Jump( true, begLabel );
  838.                     OPL.DefineLabel( expression.fJump );
  839.                 | Nrepeat :
  840.                     expression.tJump := OPL.NewLabel;
  841.                     expression.fJump := OPL.NewLabel;
  842.                     OPL.DefineLabel( expression.fJump );
  843.                     StatSeq( node.left );
  844.                     OPL.BegStat;
  845.                     Expr( node.right, expression );
  846.                     OPC.FalseJump( expression, expression.fJump );
  847.                 | Nloop :
  848.                     savedLoopEnd := loopEnd;
  849.                     begLabel := OPL.NewLabel;
  850.                     loopEnd := OPL.NewLabel;
  851.                     OPL.DefineLabel( begLabel );
  852.                     StatSeq( node.left );
  853.                     OPL.Jump( true, begLabel );
  854.                     OPL.DefineLabel( loopEnd );
  855.                     loopEnd := savedLoopEnd;
  856.                 | Nexit :
  857.                     OPL.Jump( true, loopEnd );
  858.                 | Nreturn :
  859.                     IF node.left # NIL THEN
  860.                         expression.tJump := OPL.NewLabel;
  861.                         expression.fJump := OPL.NewLabel;
  862.                         Expr( node.left, expression )
  863.                     END;
  864.                     OPC.Return( node.obj, node.left # NIL, expression );
  865.                 | Nwith :
  866.                     IfStatement( node, node.subcl = 0 );
  867.                 | Ntrap :
  868.                     IF node.right.conval.intval = 0 THEN node.right.conval.intval := 14 END ; (* should be parameter for front end*)
  869.                     OPC.Trap( SHORT( node.right.conval.intval ) );
  870.             END; (* CASE *)
  871.             Checkpc;
  872.             node := node.link;
  873.         END; (* WHILE *)
  874.     END StatSeq;
  875.     PROCEDURE Module*( prog : OPT.Node );
  876.     BEGIN
  877.         StatSeq( prog )
  878.     END Module;
  879. END OPV.
  880.